home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / cmdialog / frmcd.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-07-17  |  7.3 KB  |  225 lines
  1. VERSION 2.00
  2. Begin Form frmCD 
  3.    Caption         =   "Common Dialogs Example"
  4.    ClientHeight    =   3870
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1485
  7.    ClientWidth     =   7365
  8.    Height          =   4275
  9.    Left            =   1035
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   3870
  12.    ScaleWidth      =   7365
  13.    Top             =   1140
  14.    Width           =   7485
  15.    Begin CommonDialog CMDialog1 
  16.       Left            =   6840
  17.       Top             =   3360
  18.    End
  19.    Begin CommandButton btnCD 
  20.       Caption         =   "Close"
  21.       FontBold        =   0   'False
  22.       FontItalic      =   0   'False
  23.       FontName        =   "MS Sans Serif"
  24.       FontSize        =   8.25
  25.       FontStrikethru  =   0   'False
  26.       FontUnderline   =   0   'False
  27.       Height          =   495
  28.       Index           =   5
  29.       Left            =   5685
  30.       TabIndex        =   6
  31.       Top             =   2835
  32.       Width           =   1215
  33.    End
  34.    Begin CommandButton btnCD 
  35.       Caption         =   "Print"
  36.       FontBold        =   0   'False
  37.       FontItalic      =   0   'False
  38.       FontName        =   "MS Sans Serif"
  39.       FontSize        =   8.25
  40.       FontStrikethru  =   0   'False
  41.       FontUnderline   =   0   'False
  42.       Height          =   495
  43.       Index           =   4
  44.       Left            =   5685
  45.       TabIndex        =   5
  46.       Top             =   2340
  47.       Width           =   1215
  48.    End
  49.    Begin CommandButton btnCD 
  50.       Caption         =   "Font"
  51.       FontBold        =   0   'False
  52.       FontItalic      =   0   'False
  53.       FontName        =   "MS Sans Serif"
  54.       FontSize        =   8.25
  55.       FontStrikethru  =   0   'False
  56.       FontUnderline   =   0   'False
  57.       Height          =   495
  58.       Index           =   3
  59.       Left            =   5685
  60.       TabIndex        =   4
  61.       Top             =   1845
  62.       Width           =   1215
  63.    End
  64.    Begin CommandButton btnCD 
  65.       Caption         =   "Color"
  66.       FontBold        =   0   'False
  67.       FontItalic      =   0   'False
  68.       FontName        =   "MS Sans Serif"
  69.       FontSize        =   8.25
  70.       FontStrikethru  =   0   'False
  71.       FontUnderline   =   0   'False
  72.       Height          =   495
  73.       Index           =   2
  74.       Left            =   5685
  75.       TabIndex        =   3
  76.       Top             =   1350
  77.       Width           =   1215
  78.    End
  79.    Begin CommandButton btnCD 
  80.       Caption         =   "Save As"
  81.       FontBold        =   0   'False
  82.       FontItalic      =   0   'False
  83.       FontName        =   "MS Sans Serif"
  84.       FontSize        =   8.25
  85.       FontStrikethru  =   0   'False
  86.       FontUnderline   =   0   'False
  87.       Height          =   495
  88.       Index           =   1
  89.       Left            =   5685
  90.       TabIndex        =   2
  91.       Top             =   855
  92.       Width           =   1215
  93.    End
  94.    Begin CommandButton btnCD 
  95.       Caption         =   "Open"
  96.       FontBold        =   0   'False
  97.       FontItalic      =   0   'False
  98.       FontName        =   "MS Sans Serif"
  99.       FontSize        =   8.25
  100.       FontStrikethru  =   0   'False
  101.       FontUnderline   =   0   'False
  102.       Height          =   495
  103.       Index           =   0
  104.       Left            =   5685
  105.       TabIndex        =   1
  106.       Top             =   360
  107.       Width           =   1215
  108.    End
  109.    Begin TextBox txtCD 
  110.       Height          =   3510
  111.       Left            =   75
  112.       MultiLine       =   -1  'True
  113.       TabIndex        =   0
  114.       Top             =   165
  115.       Width           =   5130
  116.    End
  117. Sub btnCD_Click (Index As Integer)
  118. Dim BeginPage, EndPage, NumPage
  119.     Select Case Index
  120.         Case 0 'User chose Open
  121.             CMDialog1.Filename = ""
  122.             CMDialog1.Filter = "Text Files (*.TXT)|*.TXT|Batch Files (*.BAT)|*.BAT|All Files (*.*)|*.*"
  123.             CMDialog1.FilterIndex = 1
  124.             CMDialog1.Action = 1
  125.             Filename = CMDialog1.Filename
  126.             OpenFile (Filename)
  127.             txtCD.SetFocus
  128.         Case 1 'User chose Save As
  129.             CMDialog1.Filename = ""
  130.             CMDialog1.Filter = "Text Files (*.TXT)|*.TXT|Batch Files (*.BAT)|*.BAT|All Files (*.*)|*.*"
  131.             CMDialog1.FilterIndex = 1
  132.             CMDialog1.Action = 2
  133.             Filename = CMDialog1.Filename
  134.             CloseFile (Filename)
  135.         Case 2 'User chose Color
  136.             CMDialog1.CancelError = True
  137.             On Error GoTo ErrHandler
  138.             CMDialog1.Flags = &H1&
  139.             CMDialog1.Action = 3
  140.             frmCD.BackColor = CMDialog1.Color
  141.         Case 3 'User chose Font
  142.             CMDialog1.CancelError = True
  143.             On Error GoTo ErrHandler
  144.             CMDialog1.Flags = &H1&
  145.             CMDialog1.Action = 4
  146.             txtCD.FontName = CMDialog1.FontName
  147.             txtCD.FontSize = CMDialog1.FontSize
  148.             txtCD.FontBold = CMDialog1.FontBold
  149.             txtCD.FontItalic = CMDialog1.FontItalic
  150.             txtCD.FontUnderLine = CMDialog1.FontUnderLine
  151.             txtCD.FontStrikeThru = CMDialog1.FontStrikeThru
  152.             txtCD.ForeColor = CMDialog1.Color
  153.         Case 4 'User chose Print
  154.             On Error Resume Next
  155.             CMDialog1.CancelError = True
  156.             CMDialog1.Flags = PD_ALLPAGES Or PD_DISABLEPRINTTOFILE Or PD_NOPAGENUMS Or PD_SHOWHELP
  157.             CMDialog1.Min = 1
  158.             CMDialog1.Max = 1
  159.             CMDialog1.Action = 5
  160.             If Err = 32755 Then Exit Sub
  161.             Copies% = CMDialog1.Copies
  162.             For I% = 1 To Copies%
  163.             T$ = frmCD.txtCD.Text
  164.             'Get the formatted text(50 Characters wide).
  165.             'Uses the WordWrap function of the Procedures
  166.             'section of this form.
  167.             Wrapped$ = WordWrap$(T$, 50)'<== Change this number to change the width of the printed text.
  168.             Printer.Print Wrapped$
  169.             Printer.NewPage
  170.             Next I%
  171.             Printer.EndDoc
  172.         Case 5 'User chose Close
  173.             txtCD.Text = ""
  174.             Unload frmCD
  175.         End Select
  176. ErrHandler:
  177.     Exit Sub
  178. End Sub
  179. Function WordWrap$ (St$, length)
  180. 'This WordWrap function was written by Carl Franklin.
  181.     ' This function converts raw text into CRLF delimited lines.
  182.     length = length + 1
  183.     St$ = Trim$(St$)
  184.     Cr$ = Chr$(13)
  185.     Crlf$ = Chr$(13) & Chr$(10)
  186.     Do
  187.         L = Len(NextLine$)
  188.         S = InStr(St$, " ")
  189.         C = InStr(St$, Cr$)
  190.     If C Then
  191.         If L + C <= length Then
  192.             Text$ = Text$ & NextLine$ & Left$(St$, C)
  193.             NextLine$ = ""
  194.             St$ = Mid$(St$, C + 1)
  195.             GoTo LoopHere
  196.         End If
  197.     End If
  198.     If S Then
  199.     If L + S <= length Then
  200.         DoneOnce = True
  201.         NextLine$ = NextLine$ & Left$(St$, S)
  202.         St$ = Mid$(St$, S + 1)
  203.     ElseIf S > length Then
  204.         Text$ = Text$ & Crlf$ & Left$(St$, length)
  205.         St$ = Mid$(St$, length + 1)
  206.     Else
  207.         Text$ = Text$ & NextLine$ & Crlf$
  208.         NextLine$ = ""
  209.     End If
  210.     If L Then
  211.         If L + Len(St4) > length Then
  212.             Text$ = Text$ & NextLine$ & Crlf$ & St$ & Crlf$
  213.         Else
  214.             Text$ = Text$ & NextLine$ & St$ & Crlf$
  215.         End If
  216.     Else
  217.         Text$ = Text$ & St$ & Crlf$
  218.     End If
  219.     Exit Do
  220. End If
  221. LoopHere:
  222.     Loop
  223.     WordWrap$ = Text$
  224. End Function
  225.